#lang rosetta-racket


(require srfi/13)

(require rosetta/apps/autocad-render)

(require "googlewiki.rkt")


(define (path=? path1 path2)
  (string-ci=? (path->string path1) (path->string path2)))


; returns a list of files of directory "dir", whose elements are complete paths to those files
; dir: complete path to a directory
(define (find-directory-files dir)
  (map
   (λ (path) (path->complete-path path dir))
   (directory-list dir)))


; returns the name of a file or directory specified by path
(define (path-name path)
  (path->string (file-name-from-path path)))

; tests if the name of a file or directory specified by path is equal to name
(define (path-name=? path name)
  (string=? (path-name path) name))

; tests if the name of a file or directory specified by "path" matches "regex"
(define (path-name-match? path regex)
  (regexp-match regex (path-name path)))

; finds a subfile of "dir" with the specified "name"
(define (find-subfile dir name)
  (findf
   (λ (path)
     (and
      (file-exists? path)
      (path-name=? path name)))
   (find-directory-files dir)))

; finds all subfiles of "dir" that match the regexp "regex"
(define (find-subfile-regex dir regex)
  (filter
   (λ (path)
     (and
      (file-exists? path)
      (path-name-match? path regex)))
   (find-directory-files dir)))

; finds a subdirectory of "dir" with the specified "name"
(define (find-subdirectory dir name)
  (findf
   (λ (path)
     (and
      (directory-exists? path)
      (path-name=? path name)))
   (find-directory-files dir)))


; return the "extension" of a file specified by "path"
(define (path-extension path)
  (let ((extension (filename-extension path)))
    (if extension
        (bytes->string/utf-8 extension)
        "")))

; tests if the extension of a file specified by "path" is equal to "extension"
(define (path-extension=? extension path)
  (string=? (path-extension path) extension))

; finds the files of "dir" with the specified "extension"
(define (find-directory-files-extension dir extension)
  (filter (cλ path-extension=? extension) (find-directory-files dir)))


; distros and filesystem

; finds the distro path (C:\Users\joe\Desktop\distros\shelter)
; distro-dir: fs location of distros
; distro-name: name of distro to find
(define (find-distro-path distro-dir distro-name)
  (let ((path (findf
               (λ (path) (string=? (path->string (file-name-from-path path)) distro-name))
               (directory-list distro-dir))))
    (if path
        (path->complete-path path distro-dir)
        #f)))

; finds all distro paths ([C:\Users\joe\Desktop\distros\shelter C:\Users\joe\Desktop\distros\shape-cloud])
; distro-dir: fs location of distros
(define (find-distro-paths distro-dir)
  (filter
   directory-exists?
   (map
    (λ (path) (path->complete-path path distro-dir))
    (directory-list distro-dir))))

; finds distro name of specified distro
; distro-path: fs location of distro
(define (find-distro-name distro-path)
  (path->string (file-name-from-path distro-path)))

; finds fs location of documentation directory of a distro
; distro-path: fs location of distro
(define (find-distro-doc-path distro-path)
  (find-subdirectory distro-path "doc"))

; finds documentation files of a distro
; distro-path: fs location of distro
(define (find-distro-doc-files distro-path)
  (find-directory-files-extension (find-distro-doc-path distro-path) "scrbl"))

; finds fs location of figure directory of a distro
; distro-path: fs location of distro
(define (find-distro-fig-path distro-path)
  (find-subdirectory distro-path "fig"))

; finds figure files of a distro
; distro-path: fs location of distro
(define (find-distro-fig-files distro-path)
  (find-directory-files-extension (find-distro-fig-path distro-path) "png"))

; finds fs location of source directory of a distro
; distro-path: fs location of distro
(define (find-distro-src-path distro-path)
  (find-subdirectory distro-path "src"))

; finds source files of a distro
; distro-path: fs location of distro
(define (find-distro-src-files distro-path)
  (find-directory-files (find-distro-src-path distro-path)))

; finds the main source file of a distro specified by "distro-path"
; distro-path: fs location of distro
(define (find-distro-main-src-file distro-path)
  (find-subfile (find-distro-src-path distro-path) "main.rkt"))

; finds the example files of a distro specified by "distro-path"
; distro-path: fs location of distro
(define (find-distro-example-src-files distro-path)
  (find-subfile-regex (find-distro-src-path distro-path) (regexp "^.*-example\\.rkt$")))


; source manipulation

; checks the syntax of source file specified by "source-path"
; source-path: fs location of a racket source file
(define (check-source source-path)
  (dynamic-require source-path #f)
  source-path)


(define runtime-phase 0)

(define (get-source-contracts source-path)
  (let-values (((exported-names _) (module->exports source-path)))
    (rest (assoc runtime-phase exported-names))))

(define (get-source-syms source-path)
  (let ((contracts (get-source-contracts source-path)))
    (map first contracts)))

(define (get-source-example-syms source-path)
  (filter
   (λ (sym) (regexp-match (regexp "^.*-example$") (symbol->string sym)))
   (get-source-syms source-path)))

(define (get-source-binding source-path sym)
  (dynamic-require source-path sym))

(define (get-source-bindings source-path)
  (map (cλ get-source-binding source-path) (get-source-syms source-path)))

(define (get-source-example-bindings source-path)
  (map (cλ get-source-binding source-path) (get-source-example-syms source-path)))


; rosetta

;; distros and filesystem

; finds distro paths of all distros
; finds distro path of distro specified by "name"
(define rosetta-distro-path
  (case-lambda
    (() (find-distro-paths (distro-dir)))
    ((name) (find-distro-path (distro-dir) name))))

; finds all distro names
(define (rosetta-distro-names)
  (map find-distro-name (rosetta-distro-path)))

; finds fs location of documentation directory of a distro
; distro-path: fs location of distro
(define rosetta-distro-doc-paths
  (case-lambda
    (() (map find-distro-doc-path (rosetta-distro-path)))
    ((name) (find-distro-doc-path (rosetta-distro-path name)))))

; finds documentation files of all distros
; finds documentation files of distro specified by "name"
(define rosetta-distro-doc-files
  (case-lambda
    (() (map find-distro-doc-files (rosetta-distro-path)))
    ((name) (find-distro-doc-files (rosetta-distro-path name)))))

; finds figure files of all distros
; finds figure files of distro specified by "name"
(define rosetta-distro-fig-files
  (case-lambda
    (() (map find-distro-fig-files (rosetta-distro-path)))
    ((name) (find-distro-fig-files (rosetta-distro-path name)))))

; finds source files of all distros
; finds source files of distro specified by "name"
(define rosetta-distro-src-files
  (case-lambda
    (() (map find-distro-src-files (rosetta-distro-path)))
    ((name) (find-distro-src-files (rosetta-distro-path name)))))

; finds the main source file of all distros
; finds the main source file of distro specified by "name"
(define rosetta-distro-main-src-file
  (case-lambda
    (() (map find-distro-main-src-file (rosetta-distro-path)))
    ((name) (find-distro-main-src-file (rosetta-distro-path name)))))

; finds the example source files of all distros
; finds the example source files of distro specified by "name"
(define rosetta-distro-example-src-files
  (case-lambda
    (() (map find-distro-example-src-files (rosetta-distro-path)))
    ((name) (find-distro-example-src-files (rosetta-distro-path name)))))


;; source manipulation

(define rosetta-check-source
  (case-lambda
    (() (map check-source (rosetta-distro-main-src-file)))
    ((name) (check-source (rosetta-distro-main-src-file name)))))

(define rosetta-source-syms
  (case-lambda
    (() (map get-source-syms (rosetta-check-source)))
    ((name) (get-source-syms (rosetta-check-source name)))))

(define rosetta-source-example-syms
  (case-lambda
    (() (map get-source-example-syms (rosetta-check-source)))
    ((name) (get-source-example-syms (rosetta-check-source name)))))

(define rosetta-source-bindings
  (case-lambda
    (() (map get-source-bindings (rosetta-check-source)))
    ((name) (get-source-bindings (rosetta-check-source name)))
    ((name sym) (get-source-binding (rosetta-check-source name) sym))))

(define rosetta-source-example-bindings
  (case-lambda
    (() (map get-source-example-bindings (rosetta-check-source)))
    ((name) (get-source-example-bindings (rosetta-check-source name)))))


;; run & render

(define rosetta-proxies (list autocad rhino))


(define (run-example-binding proxy fn)
  (backend proxy)
  (evaluate-toplevel (fn)))

(define rosetta-run
  (case-lambda
    (() (map rosetta-run (rosetta-distro-names)))
    ((name) (map (cλ rosetta-run name) rosetta-proxies))
    ((name sym/proxy)
     (if (symbol? sym/proxy)
         (map (λ (proxy) (run-example-binding proxy (rosetta-source-bindings name sym/proxy))) rosetta-proxies)
         (map (cλ run-example-binding sym/proxy) (rosetta-source-example-bindings name))))
    ((name sym proxy)
     (run-example-binding proxy (rosetta-source-example-bindings name sym)))))


(define (render-binding-autocad sym fn)
  (backend-autocad-template)
  (render-with-floor (fn) sym))

(define rosetta-render
  (case-lambda
    (() (map rosetta-render (rosetta-distro-names)))
    ((name) (map render-binding-autocad (rosetta-source-example-syms name) (rosetta-source-example-bindings name)))
    ((name sym)
     (render-binding-autocad sym (rosetta-source-bindings name sym)))))


;; rosetta-lang

(define (distro-name->googlewiki-name name)
  (string-delete #\- (string-titlecase name)))

(define (fig-path->fig-url base-url fig-path)
  (format "~A~A" base-url (path-name fig-path)))

; edit: getting only the first doc file
; renders the scribble documentation files of distros and output googlewiki pages in rosetta-lang dir
(define rosetta-lang-install-doc
  (case-lambda
    (() (map rosetta-lang-install-doc (rosetta-distro-names)))
    ((name) (let ((docs (rosetta-distro-doc-files name)))
              (unless (empty? docs)
                (make-googlewiki-doc
                 (first docs)
                 (string-append (distro-name->googlewiki-name name) ".wiki")
                 (rosetta-lang-wiki-path)
                 (map (cλ fig-path->fig-url (rosetta-lang-wiki-figs-url)) (rosetta-distro-fig-files name))
                 (rosetta-distro-example-src-files name)))))))

(define (copy-fig base-url fig-path)
  (let ((fig-dest-path (build-path base-url (path-name fig-path))))
    (when (file-exists? fig-dest-path)
      (delete-file fig-dest-path))
    (copy-file fig-path fig-dest-path)))

; copies the figure files of distros to rosetta-lang fig dir
(define rosetta-lang-install-figs
  (case-lambda
    (() (map rosetta-lang-install-figs (rosetta-distro-names)))
    ((name) (map (cλ copy-fig (rosetta-lang-wiki-figs-path)) (rosetta-distro-fig-files name)))))


;; distro pl

(define distro
  (case-lambda
    (() (rosetta-distro-path))
    ((name) (append
             (rosetta-distro-doc-files name)
             (rosetta-distro-fig-files name)
             (rosetta-distro-src-files name)))
    ((name sym) (case sym
                  ('all (rosetta-source-syms name))
                  ('example (rosetta-source-example-syms name))
                  (else (rosetta-source-bindings name sym))))))